home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
376-400
/
disk_386
/
xlispstat
/
src1.lzh
/
XLisp
/
xlinit.c
< prev
next >
Wrap
C/C++ Source or Header
|
1990-10-04
|
8KB
|
242 lines
/* xlinit.c - xlisp initialization module */
/* Copyright (c) 1989, by David Michael Betz. */
/* You may give out copies of this software; for conditions see the file */
/* COPYING included with this distribution. */
#include "xlisp.h"
#include "osdef.h"
#ifdef ANSI
#include "xlproto.h"
#include "xlsproto.h"
#include "osproto.h"
#else
#include "xlfun.h"
#include "xlsfun.h"
#include "osfun.h"
#endif ANSI
#include "xlvar.h"
#ifdef ANSI
void initwks(void);
#else
void initwks();
#endif ANSI
/* xlinit - xlisp initialization routine */
void xlinit()
{
/* initialize xlisp (must be in this order) */
xlminit(); /* initialize xldmem.c */
xldinit(); /* initialize xldbug.c */
/* finish initializing */
#ifdef SAVERESTORE
if (!xlirestore("xlisp.wks"))
#endif
initwks();
#ifndef XLISP_ONLY
#ifdef SAVERESTORE /* L. Tierney */
else if (consp(getvalue(xlenter("*HARDWARE-OBJECTS*")))) {
LVAL hlist, s_hardware_objects = xlenter("*HARDWARE-OBJECTS*");
LVAL sk_allocate = xlenter(":ALLOCATE");
LVAL copylist();
xlsave1(hlist);
hlist = copylist(getvalue(s_hardware_objects));
setvalue(s_hardware_objects, NIL);
for (; consp(hlist); hlist = cdr(hlist))
send_message(car(cdr(cdr(car(hlist)))), sk_allocate);
xlpop();
}
#endif /* SAVERESTORE */
#endif /* XLISP_ONLY */
}
/* initwks - build an initial workspace */
LOCAL void initwks()
{
FUNDEF *p;
int i;
xlsinit(); /* initialize xlsym.c */
xlsymbols();/* enter all symbols used by the interpreter */
xlrinit(); /* initialize xlread.c */
xloinit(); /* initialize xlobj.c */
/* setup defaults */
setvalue(s_evalhook,NIL); /* no evalhook function */
setvalue(s_applyhook,NIL); /* no applyhook function */
setvalue(s_tracelist,NIL); /* no functions being traced */
setvalue(s_tracenable,NIL); /* traceback disabled */
setvalue(s_tlimit,NIL); /* trace limit infinite */
setvalue(s_breakenable,NIL); /* don't enter break loop on errors */
setvalue(s_gcflag,NIL); /* don't show gc information */
setvalue(s_gchook,NIL); /* no gc hook active */
setvalue(s_ifmt,cvstring(IFMT)); /* integer print format */
setvalue(s_ffmt,cvstring("%g")); /* float print format */
setvalue(s_printcase,k_upcase); /* upper case output of symbols */
/* install the built-in functions and special forms */
for (i = 0, p = funtab; p->fd_subr != NULL; ++i, ++p)
if (p->fd_name)
xlsubr(p->fd_name,p->fd_type,p->fd_subr,i);
/* add some synonyms */
setfunction(xlenter("NOT"),getfunction(xlenter("NULL")));
setfunction(xlenter("FIRST"),getfunction(xlenter("CAR")));
setfunction(xlenter("SECOND"),getfunction(xlenter("CADR")));
setfunction(xlenter("THIRD"),getfunction(xlenter("CADDR")));
setfunction(xlenter("FOURTH"),getfunction(xlenter("CADDDR")));
setfunction(xlenter("REST"),getfunction(xlenter("CDR")));
osfinit(); /* L. Tierney */
}
/* xlsymbols - enter all of the symbols used by the interpreter */
void xlsymbols()
{
LVAL sym;
/* enter the unbound variable indicator (must be first) */
s_unbound = xlenter("*UNBOUND*");
setvalue(s_unbound,s_unbound);
/* enter the 't' symbol */
true = xlenter("T");
setvalue(true,true);
/* enter some important symbols */
s_dot = xlenter(".");
s_quote = xlenter("QUOTE");
s_function = xlenter("FUNCTION");
s_bquote = xlenter("BACKQUOTE");
s_comma = xlenter("COMMA");
s_comat = xlenter("COMMA-AT");
s_lambda = xlenter("LAMBDA");
s_macro = xlenter("MACRO");
s_eql = xlenter("EQL");
s_ifmt = xlenter("*INTEGER-FORMAT*");
s_ffmt = xlenter("*FLOAT-FORMAT*");
/* symbols set by the read-eval-print loop */
s_1plus = xlenter("+");
s_2plus = xlenter("++");
s_3plus = xlenter("+++");
s_1star = xlenter("*");
s_2star = xlenter("**");
s_3star = xlenter("***");
s_minus = xlenter("-");
/* enter setf place specifiers */
s_setf = xlenter("*SETF*");
s_car = xlenter("CAR");
s_cdr = xlenter("CDR");
s_nth = xlenter("NTH");
s_aref = xlenter("AREF");
s_get = xlenter("GET");
s_svalue = xlenter("SYMBOL-VALUE");
s_sfunction = xlenter("SYMBOL-FUNCTION");
s_splist = xlenter("SYMBOL-PLIST");
/* enter the readtable variable and keywords */
s_rtable = xlenter("*READTABLE*");
k_wspace = xlenter(":WHITE-SPACE");
k_const = xlenter(":CONSTITUENT");
k_nmacro = xlenter(":NMACRO");
k_tmacro = xlenter(":TMACRO");
k_sescape = xlenter(":SESCAPE");
k_mescape = xlenter(":MESCAPE");
/* enter parameter list keywords */
k_test = xlenter(":TEST");
k_tnot = xlenter(":TEST-NOT");
/* "open" keywords */
k_direction = xlenter(":DIRECTION");
k_input = xlenter(":INPUT");
k_output = xlenter(":OUTPUT");
/* enter *print-case* symbol and keywords */
s_printcase = xlenter("*PRINT-CASE*");
k_upcase = xlenter(":UPCASE");
k_downcase = xlenter(":DOWNCASE");
/* other keywords */
k_start = xlenter(":START");
k_end = xlenter(":END");
k_1start = xlenter(":START1");
k_1end = xlenter(":END1");
k_2start = xlenter(":START2");
k_2end = xlenter(":END2");
k_verbose = xlenter(":VERBOSE");
k_print = xlenter(":PRINT");
k_count = xlenter(":COUNT");
k_key = xlenter(":KEY");
/* enter lambda list keywords */
lk_optional = xlenter("&OPTIONAL");
lk_rest = xlenter("&REST");
lk_key = xlenter("&KEY");
lk_aux = xlenter("&AUX");
lk_allow_other_keys = xlenter("&ALLOW-OTHER-KEYS");
/* enter *standard-input*, *standard-output* and *error-output* */
s_stdin = xlenter("*STANDARD-INPUT*");
setvalue(s_stdin,cvfile(stdin));
s_stdout = xlenter("*STANDARD-OUTPUT*");
setvalue(s_stdout,cvfile(stdout));
s_stderr = xlenter("*ERROR-OUTPUT*");
setvalue(s_stderr,cvfile(stderr));
/* enter *debug-io* and *trace-output* */
s_debugio = xlenter("*DEBUG-IO*");
setvalue(s_debugio,getvalue(s_stderr));
s_traceout = xlenter("*TRACE-OUTPUT*");
setvalue(s_traceout,getvalue(s_stderr));
/* enter the eval and apply hook variables */
s_evalhook = xlenter("*EVALHOOK*");
s_applyhook = xlenter("*APPLYHOOK*");
/* enter the symbol pointing to the list of functions being traced */
s_tracelist = xlenter("*TRACELIST*");
/* enter the error traceback and the error break enable flags */
s_tracenable = xlenter("*TRACENABLE*");
s_tlimit = xlenter("*TRACELIMIT*");
s_breakenable = xlenter("*BREAKENABLE*");
/* enter a symbol to control printing of garbage collection messages */
s_gcflag = xlenter("*GC-FLAG*");
s_gchook = xlenter("*GC-HOOK*");
/* Added so gc works during initialization. L. Tierney */
setvalue(s_gcflag,NIL); /* don't show gc information */
setvalue(s_gchook,NIL); /* no gc hook active */
/* enter a copyright notice into the oblist */
sym = xlenter("**Copyright-1988-by-David-Betz**");
setvalue(sym,true);
/* enter type names */
a_subr = xlenter("SUBR");
a_fsubr = xlenter("FSUBR");
a_cons = xlenter("CONS");
a_symbol = xlenter("SYMBOL");
a_fixnum = xlenter("FIXNUM");
a_flonum = xlenter("FLONUM");
a_string = xlenter("STRING");
a_object = xlenter("OBJECT");
a_stream = xlenter("FILE-STREAM");
a_vector = xlenter("VECTOR"); /* L. Tierney */
a_closure = xlenter("CLOSURE");
a_char = xlenter("CHARACTER");
a_ustream = xlenter("UNNAMED-STREAM");
a_complex = xlenter("COMPLEX"); /* L. Tierney */
a_array = xlenter("ARRAY"); /* L. Tierney */
/* add the object-oriented programming symbols and os specific stuff */
obsymbols(); /* object-oriented programming symbols */
ossymbols(); /* os specific symbols */
}